home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / RESDMP11 / RESDUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-02  |  14KB  |  484 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L-,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y-}
  2. {$M 16384,0,655360}
  3. {uses unit KEYNAMER.PAS (corrected!) from examples of TURBO PASCAL 7.0,
  4.  copyright 1992 by Borland,
  5.  uses ShoeHorn function from RESEDIT 2.0, copyright 1992 by Blaise Comp.}
  6.  
  7. unit resdutil;
  8.  
  9. interface
  10.   uses DOS,drivers,objects,views,dialogs;
  11.  
  12.  
  13. FUNCTION FDate : String;
  14. FUNCTION FTime : String;
  15. FUNCTION FBase ( s : PathStr ) : String;
  16. FUNCTION FileExist ( p : PathStr ) : boolean;
  17.  
  18. FUNCTION KeyName( key: word): String;
  19.  
  20. FUNCTION ReplaceControl(Dialog : PDialog;
  21.                         Control : PView;
  22.                         CurHelpCtx:word;
  23.                         CurTypeOf : Pointer ) : PView;
  24.  
  25.  
  26. implementation
  27.  
  28. FUNCTION FileExist ( p : PathStr ) : boolean;
  29.   VAR f : text;
  30.   BEGIN
  31.      Assign(f,p);
  32.     {$I-}Reset(f);{$I+}
  33.     IF IOResult<>0
  34.       THEN FileExist := false
  35.       ELSE BEGIN FileExist := true; close(f)  END;
  36.   END;
  37.  
  38. FUNCTION FBase ( s : PathStr ) : String;
  39.   VAR d : DirStr; n : NameStr; e : ExtStr;
  40.   BEGIN
  41.     FSplit ( s, d, n, e );
  42.     FBase := n+e;
  43.   END;
  44.  
  45. FUNCTION FDate : String;
  46.   CONST DateFormat : String = '%02d.%02d.%02d';
  47.   VAR Params : ARRAY[1..3] OF longint;
  48.       i : integer;
  49.       d,m,y,wd : word;
  50.       td : String;
  51.   BEGIN
  52.     GetDate(y,m,d,wd); y := y-1900;
  53.     Params[1] := d;
  54.     Params[2] := m;
  55.     Params[3] := y;
  56.     Formatstr(td,DateFormat,Params);
  57.     FDate := copy(td, 1, 8 );
  58.   END; {FUNC FDate}
  59.  
  60.  
  61. FUNCTION FTime : String;
  62.   CONST TimeFormat = '%02d:%02d:%02d';
  63.   VAR Params : RECORD lh,lm,ls,lcs : longint; END;
  64.       h,m,s,cs : word;
  65.       ts : String;
  66.   BEGIN
  67.     GetTime(h,m,s,cs);
  68.     WITH Params DO
  69.       BEGIN  lh := h; lm := m; ls := s; lcs := cs;  END;
  70.     Formatstr(ts,TimeFormat,Params);
  71.     FTime := ts;
  72.   END; {FUNC FTime}
  73.  
  74.  
  75. function KeyName( key: word): String;
  76. const
  77.   QWERTY: String[10] = 'QWERTYUIOP';
  78.   ASDF: String[9] = 'ASDFGHJKL';
  79.   ZXCV: String[7] = 'ZXCVBNM';
  80. var
  81.   st: String;
  82. begin
  83.   KeyName:='';
  84.   case key of
  85.     0..31: KeyName:= 'Control-'+char(key+64);
  86.        32: KeyName:= 'Spacebar';
  87.   33..125: KeyName:= Char(key);
  88.     $011B: KeyName:= 'kbEsc';
  89.     $0200: KeyName:= 'kbAltSpace';
  90.     $0400: KeyName:= 'kbCtrlIns';
  91.     $0500: KeyName:= 'kbShiftIns';
  92.     $0600: KeyName:= 'kbCtrlDel';
  93.     $0700: KeyName:= 'kbShiftDel';
  94.     $0E08: KeyName:= 'kbBack';
  95.     $0E7F: KeyName:= 'kbCtrlBack';
  96.     $0F00: KeyName:= 'kbShiftTab';
  97.     $0F09: KeyName:= 'kbTab';
  98.     $1C0A: KeyName:= 'kbCtrlEnter';
  99.     $1C0D: KeyName:= 'kbEnter';
  100.     $4700: KeyName:= 'kbHome';
  101.     $4800: KeyName:= 'kbUp';
  102.     $4900: KeyName:= 'kbPgUp';
  103.     $4A2D: KeyName:= 'kbGrayMinus';
  104.     $4B00: KeyName:= 'kbLeft';
  105.     $4D00: KeyName:= 'kbRight';
  106.     $4E2B: KeyName:= 'kbGrayPlus';
  107.     $4F00: KeyName:= 'kbEnd';
  108.     $5000: KeyName:= 'kbDown';
  109.     $5100: KeyName:= 'kbPgDn';
  110.     $5200: KeyName:= 'kbIns';
  111.     $5300: KeyName:= 'kbDel';
  112.     $7200: KeyName:= 'kbCtrlPrtSc';
  113.     $7300: KeyName:= 'kbCtrlLeft';
  114.     $7400: KeyName:= 'kbCtrlRight';
  115.     $7500: KeyName:= 'kbCtrlEnd';
  116.     $7600: KeyName:= 'kbCtrlPgDn';
  117.     $7700: KeyName:= 'kbCtrlHome';
  118.     $8200: KeyName:= 'kbAltMinus';
  119.     $8300: KeyName:= 'kbAltEqual';
  120.     $8400: KeyName:= 'kbCtrlPgUp';
  121.     $0000: KeyName:= 'kbNoKey';
  122.   else
  123.     if Lo(key) = 0 then
  124.     begin
  125.       key := hi(key);
  126.       case key of
  127.         $10..$19:  KeyName:= 'kbAlt'+ QWERTY[key-$0F];
  128.         $1E..$26:  KeyName:= 'kbAlt'+ ASDF[key-$1D];
  129.         $2C..$32:  KeyName:= 'kbAlt'+ ZXCV[key-$2B];
  130.         $3B..$44:
  131.           begin
  132.             Str((key-$3A):0,st);
  133.             KeyName:= 'kbF'+st;
  134.           end;
  135.         $54..$5D:
  136.           begin
  137.             Str((key-$53):0,st);
  138.             KeyName:= 'kbShiftF'+st;
  139.           end;
  140.         $5E..$67:
  141.           begin
  142.             Str((key-$5D):0,st);
  143.             KeyName:= 'kbCtrlF'+st;
  144.           end;
  145.         $68..$71:
  146.           begin
  147.             Str((key-$67):0,st);
  148.             KeyName:= 'kbAltF'+st;
  149.           end;
  150.         $78..$80:
  151.           begin
  152.             Str((key-$77):0,st);
  153.             KeyName:= 'kbAlt'+st;
  154.           end;
  155.         $81: KeyName:= 'kbAlt0';
  156.       end;  {case}
  157.     end;
  158.   end; {case}
  159. end;
  160.  
  161. {---------------------------------------------------------------}
  162.  
  163. {  Description:
  164.  
  165.     Replace a control in a dialog box with a user "custom" control
  166.  
  167.     function ReplaceControl(Dialog : PDialog;
  168.                             Control : PView;
  169.                             CurHelpCtx:word;
  170.                             CurTypeOf : Pointer ) : PView;
  171.  
  172.           Dialog       Pointer to the dialog box to insert user
  173.                          control
  174.           Control      Pointer to the user control to insert into
  175.                          the abstract control position
  176.           CurHelpCtx   Help context of abstract control to be replaced
  177.           CurTypeOf    TypeOf abstract control to be replaced
  178.                        in case two controls share the same HelpCtx
  179.  
  180.      This function replaces a control view in a dialog box
  181.      with Control, which must be of a descendent type.  It
  182.      essentially swaps one control for another, setting the
  183.      size and location of the new view with that of the
  184.      original, and then disposing of the original.
  185.      This function is an extended version of function
  186.      bShoeHorn in the Blaise ResEdit package.
  187.  
  188.      Extension made by W. Gross. Blame him for any bugs.
  189. }
  190.  
  191. CONST ofShoeHorn = $8000;
  192.  
  193. VAR   ownCurHelpCtx : word;
  194.       ownCurTypeOf  : Pointer;
  195.  
  196. function ReplaceControl(Dialog  : PDialog;
  197.                         Control : PView;
  198.                         CurHelpCtx : word;
  199.                         CurTypeOf  : Pointer) : PView;
  200.  
  201.   var
  202.     DummyControl  : PView;
  203.     OldListViewer : PListViewer;
  204.     NewListViewer : PListViewer;
  205.     OldButton     : PButton;
  206.     NewButton     : PButton;
  207.     OldCluster    : PCluster;
  208.     NewCluster    : PCluster;
  209.     OldILine      : PInputLine;
  210.     NewILine      : PInputLine;
  211.     OldSText      : PStaticText;
  212.     NewSText      : PStaticText;
  213.     OldPText      : PParamText;
  214.     NewPText      : PParamText;
  215.     LabelP        : PLabel;
  216.     I             : Integer;
  217.  
  218.   {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  219.   {                                                                     }
  220.   { TestLabelPtr                                                        }
  221.   {                                                                     }
  222.   { function TestLabelPtr(View : PView) : boolean; far;                 }
  223.   {                                                                     }
  224.   { Description This function returns True if View is a label and its   }
  225.   {             owner is DummyControl.                                  }
  226.   {                                                                     }
  227.   {_____________________________________________________________________}
  228.  
  229.   function TestLabelPtr(View : PView) : boolean; far;
  230.  
  231.     begin {TestLabelPtr}
  232.  
  233.       if (TypeOf(View^) = TypeOf(TLabel)) and
  234.          (PLabel(View)^.Link = PView(DummyControl)) then
  235.             begin
  236.               TestLabelPtr := True;
  237.               Exit;
  238.             end;
  239.  
  240.       TestLabelPtr := False;
  241.  
  242.     end;  {TestLabelPtr}
  243.  
  244.   {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  245.   {                                                                     }
  246.   { function TestReplaceProp(View : PView) : boolean; far;              }
  247.   {                                                                     }
  248.   { Description  This function returns True if                          }
  249.   {         - the shoehorn bit, ofShoeHorn, is set in View's Options.   }
  250.   {         - the HelpCtx equals CurHelpCtx                             }
  251.   {         - the TypeOf(View) equals CurTypeOf                         }
  252.   {                                                                     }
  253.   {_____________________________________________________________________}
  254.  
  255.   function TestReplaceProp(View : PView) : boolean; far;
  256.  
  257.     begin {TestShoeHornBit}
  258.  
  259.       TestReplaceProp := ((View^.Options and ofShoeHorn) <> 0) AND
  260.                          (View^.HelpCtx=ownCurHelpCtx) AND
  261.                          (TypeOf(View^)=ownCurTypeOf);
  262.  
  263.     end;  {TestReplaceProp}
  264.  
  265.   begin {ReplaceControl}
  266.  
  267.     { Look in Z-order for first control with
  268.           - shoehorn bit set,
  269.           - HelpCtx=CurHelpCtx
  270.           - TypeOf=CurTypeOf       }
  271.  
  272.     {need these own vars for TestReplaceProp}
  273.     ownCurHelpCtx := CurHelpCtx;
  274.     ownCurTypeOf  := CurTypeOf;
  275.  
  276.     DummyControl := PView(Dialog^.FirstThat(@TestReplaceProp));
  277.  
  278.     if (DummyControl = NIL) then                { Error !               }
  279.        begin
  280.          ReplaceControl := NIL;
  281.          Exit;
  282.        end
  283.     else
  284.        begin
  285.  
  286.          { See if a label points to the dummy control so we can change  }
  287.          { its link field.                                              }
  288.  
  289.          LabelP := PLabel(Dialog^.FirstThat(@TestLabelPtr));
  290.          if (LabelP <> NIL) then
  291.             LabelP^.Link := Control;
  292.  
  293.      with Control^ do
  294.        begin
  295.  
  296.          { TView specific fields        }
  297.  
  298.          Owner    := DummyControl^.Owner;
  299.          Next    := DummyControl^.Next;
  300.          Origin    := DummyControl^.Origin;
  301.          Size    := DummyControl^.Size;
  302.          HelpCtx    := DummyControl^.HelpCtx;
  303.  
  304.        end;
  305.  
  306.      { Make sure the circular list is intact            }
  307.  
  308.      DummyControl^.Prev^.Next := Control;
  309.  
  310.      { We need to clear the owner field so that we avoid being    }
  311.      { deleted from the dialog box during Done (see TGroup.Done)    }
  312.  
  313.      DummyControl^.Owner := NIL;
  314.  
  315.      { Check the type of the original control to see which control    }
  316.      { specific fields we have to transfer to the new control.    }
  317.  
  318.      if (TypeOf(DummyControl^) = TypeOf(TListViewer)) then
  319.         begin
  320.  
  321.           OldListViewer := PListViewer(DummyControl);
  322.           NewListViewer := PListViewer(Control);
  323.  
  324.           with NewListViewer^ do
  325.         begin
  326.  
  327.           { TListViewer specific fields      }
  328.  
  329.           HScrollBar := OldListViewer^.HScrollBar;
  330.           if (HScrollBar <> NIL) then
  331.              HScrollBar^.SetParams(0,0,Range-1,1,1);
  332.  
  333.           VScrollBar := OldListViewer^.VScrollBar;
  334.           if (VScrollBar <> NIL) then
  335.              VScrollBar^.SetParams(0,0,Range-1,Size.Y-1,1);
  336.  
  337.           NumCols    := OldListViewer^.NumCols;
  338.           TopItem    := 0;
  339.  
  340.           if (Dialog^.Current = PView(OldListViewer)) then
  341.             NewListViewer^.Select;
  342.           Dispose(OldListViewer,Done);
  343.  
  344.         end;
  345.  
  346.         end
  347.      else if (TypeOf(DummyControl^) = TypeOf(TButton)) then
  348.         begin
  349.  
  350.           OldButton := PButton(DummyControl);
  351.           NewButton := PButton(Control);
  352.  
  353.           with NewButton^ do
  354.         begin
  355.  
  356.           { TButton specific fields        }
  357.  
  358.           Title     := NewStr(OldButton^.Title^);
  359.           Command   := OldButton^.Command;
  360.           Flags     := OldButton^.Flags;
  361.           AmDefault := OldButton^.AmDefault;
  362.  
  363.           if (Dialog^.Current = PView(OldButton)) then
  364.             NewButton^.Select;
  365.           Dispose(OldButton,Done);
  366.  
  367.         end;
  368.  
  369.         end
  370.      else if ((TypeOf(DummyControl^) = TypeOf(TRadioButtons)) or
  371.         (TypeOf(DummyControl^) = TypeOf(TCheckBoxes))) then
  372.         begin
  373.  
  374.           OldCluster := PCluster(DummyControl);
  375.           NewCluster := PCluster(Control);
  376.  
  377.           with NewCluster^ do
  378.         begin
  379.  
  380.           { TCluster specific fields         }
  381.  
  382.           Value   := OldCluster^.Value;
  383.           Sel      := OldCluster^.Sel;
  384.                   EnableMask := OldCluster^.EnableMask;  {!!! TV 2.0 !!!}
  385.  
  386.           { If Strings is empty, then add the strings from the    }
  387.           { base control; otherwise, allow the user to also    }
  388.           { specify the strings at run time.            }
  389.  
  390.           if (Strings.Count = 0) then
  391.              begin
  392.                Strings.FreeAll;
  393.                Strings.SetLimit(OldCluster^.Strings.Count);
  394.                for I := 0 to (OldCluster^.Strings.Count - 1) do
  395.                Strings.AtInsert(I,
  396.                NewStr(PString(OldCluster^.Strings.At(I))^) );
  397.              end;
  398.  
  399.           if (Dialog^.Current = PView(OldCluster)) then
  400.             NewCluster^.Select;
  401.           Dispose(OldCluster,Done);
  402.  
  403.         end;
  404.  
  405.         end
  406.      else if (TypeOf(DummyControl^) = TypeOf(TInputLine)) then
  407.         begin
  408.  
  409.           OldILine := PInputLine(DummyControl);
  410.           NewILine := PInputLine(Control);
  411.  
  412.           with NewILine^ do
  413.         begin
  414.  
  415.           { TInputLine specific fields           }
  416.  
  417.           if (Data <> nil) then
  418.              FreeMem( Data, MaxLen + 1 );
  419.           GetMem(Data, OldILine^.MaxLen + 1);
  420.           Data^      := OldILine^.Data^;
  421.           MaxLen    := OldILine^.MaxLen;
  422.           CurPos    := OldILine^.CurPos;
  423.           FirstPos  := OldILine^.FirstPos;
  424.           SelStart  := OldILine^.SelStart;
  425.           SelEnd    := OldILine^.SelEnd;
  426.                   Validator := OldILine^.Validator;  {!!! TV 2.0 !!!}
  427.  
  428.         end;
  429.  
  430.           if (Dialog^.Current = PView(OldILine)) then
  431.         NewILine^.Select;
  432.           Dispose(OldILine,Done);
  433.  
  434.         end
  435.      else if (TypeOf(DummyControl^) = TypeOf(TStaticText)) then
  436.         begin
  437.  
  438.           OldSText := PStaticText(DummyControl);
  439.           NewSText := PStaticText(Control);
  440.  
  441.           with NewSText^ do
  442.         begin
  443.  
  444.           { TStaticText specific fields     }
  445.  
  446.           Text := NewStr(OldSText^.Text^);
  447.  
  448.         end;
  449.  
  450.           if (Dialog^.Current = PView(OldSText)) then
  451.         NewSText^.Select;
  452.           Dispose(OldSText,Done);
  453.  
  454.         end
  455.      else if (TypeOf(DummyControl^) = TypeOf(TParamText)) then
  456.         begin
  457.  
  458.           OldPText := PParamText(DummyControl);
  459.           NewPText := PParamText(Control);
  460.  
  461.           with NewPText^ do
  462.         begin
  463.  
  464.           { TParamText specific fields        }
  465.  
  466.           Text         := NewStr(OldPText^.Text^);
  467.           ParamCount := OldPText^.ParamCount;
  468.  
  469.         end;
  470.  
  471.           if (Dialog^.Current = PView(OldPText)) then
  472.         NewPText^.Select;
  473.           Dispose(OldPText,Done);
  474.  
  475.         end;
  476.  
  477.          ReplaceControl := Control;
  478.  
  479.        end;
  480.  
  481.   end;  {FUNC ReplaceControl}
  482.  
  483.  
  484. end. {UNIT RESDUTIL}